unit uRoundRect;

interface

uses
  Extctrls, classes;

type
  TRoundRect = class(TShape)
  private
    FRound: integer;
    procedure SetRound(const Value: integer);
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    property Round:integer read FRound write SetRound;
  end;

implementation

{ TShape }

constructor TRoundRect.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Shape := stRoundRect;
  FRound := 9;
end;

procedure TRoundRect.Paint;
var
  X, Y, W, H, S: Integer;
begin
  with Canvas do
  begin
    Pen := self.Pen;
    Brush := self.Brush;
    X := Pen.Width div 2;
    Y := X;
    W := Width - Pen.Width + 1;
    H := Height - Pen.Width + 1;
    if Pen.Width = 0 then
    begin
      Dec(W);
      Dec(H);
    end;
    if W < H then S := W else S := H;
    if Shape in [stSquare, stRoundSquare, stCircle] then
    begin
      Inc(X, (W - S) div 2);
      Inc(Y, (H - S) div 2);
      W := S;
      H := S;
    end;
    case Shape of
      stRectangle, stSquare:
        Rectangle(X, Y, X + W, Y + H);
      stRoundRect, stRoundSquare:
        RoundRect(X, Y, X + W, Y + H, FRound, FRound);
      stCircle, stEllipse:
        Ellipse(X, Y, X + W, Y + H);
    end;
  end;
end;

procedure TRoundRect.SetRound(const Value: integer);
begin
  FRound := Value;
  Invalidate;
end;

end.
